ENTRY DEFFIL,FILDEF,DEVPRS,FILPRS,PRSFIL,INSWAP;
BEGIN "FILNAM"

OWN STRING DV,FN1,FN2,PRJ,PRG;

COMMENT FOR PARSING FILSPECS BETTER THAN THE SAIL SCANNER. DEFFIL ALLOWS
        DEFAULT DEV:FN1.FN2[PRJ,PRG] TO BE SET. FILDEF RETURNS CURRENT
        DEFAULTS. PRSFIL PARSES A COMPOUND FILE SPEC AND SETS DEFAULTS
        FROM DEFINED PORTIONS, FILPRS RETURNS A COMPOUND FILSPEC;

PROCEDURE DEFINIT;
IF (LENGTH(PRG)=0∨EQU(PRG,"   "))∧
   (LENGTH(PRJ)=0∨EQU(PRJ,"   "))∧
   (LENGTH(DV)=0∨EQU(DV,"      ")) THEN
   BEGIN
   INTEGER PPN;
   PPN←CALL(0,"DSKPPN");
   DV←"DSK";
   PRJ←CVXSTR(PPN)[1 TO 3];
   PRG←CVXSTR(PPN)[4 TO 6];
   END;

INTERNAL PROCEDURE DEFFIL(STRING DVD,FN1D,FN2D,PRJD,PRGD);
   BEGIN
   DEFINIT;
   IF LENGTH(DVD)>0 THEN DV←DVD;
   IF LENGTH(FN1D)>0 THEN FN1←FN1D;
   IF LENGTH(FN2D)>0 THEN FN2←FN2D;
   IF LENGTH(PRJD)>0 THEN PRJ←PRJD;
   IF LENGTH(PRGD)>0 THEN PRG←PRGD;
   END;

INTERNAL PROCEDURE FILDEF(REFERENCE STRING DVD,FN1D,FN2D,PRJD,PRGD);
   BEGIN
   DEFINIT;
   DVD←DV;
   FN1D←FN1;
   FN2D←FN2;
   PRJD←PRJ;
   PRGD←PRG;
   END;


STRING PROCEDURE H(STRING S);
   BEGIN WHILE LENGTH(S)>0 ∧ S[∞ TO ∞]=" " DO S←S[1 TO ∞-1]; RETURN(S); END;

STRING PROCEDURE T(STRING S);
   BEGIN WHILE LENGTH(S)>0 ∧ S[1 TO 1]=" " DO S←S[2 TO ∞]; RETURN(S); END;

INTERNAL STRING PROCEDURE FILPRS;
   BEGIN
   DEFINIT;
   RETURN(H(FN1)&"."&H(FN2)&
      (IF LENGTH(T(PRJ))>0∨LENGTH(T(PRG))>0 THEN "["&T(PRJ)&","&T(PRG)&"]" ELSE ""));
   END;

INTERNAL STRING PROCEDURE DEVPRS; RETURN(H(DV));

INTERNAL PROCEDURE PRSFIL(STRING FILSPEC);
   BEGIN
   BOOLEAN LITR;
   STRING S,T;
   INTEGER I,LCNT;
   IF LENGTH(FILSPEC)=0 THEN
      BEGIN
      INTEGER PPN;
      PPN←CALL(0,"DSKPPN");
      DV←"DSK";
      PRJ←CVXSTR(PPN)[1 TO 3];
      PRG←CVXSTR(PPN)[4 TO 6];
      FN1←""; FN2←"";
      END
   ELSE
      BEGIN
      DEFINIT;
      LITR←FALSE;
      S←FILSPEC;
      T←"";
      WHILE LENGTH(S)>0 ∧ (LITR ∨ S[1 TO 1]≠":") DO
      IF S[1 TO 1]="↓" THEN
	BEGIN LITR←¬LITR; S←S[2 TO ∞] END
      ELSE IF (¬LITR)∧(S[1 TO 1]=" "∨S[1 TO 1]="   "∨S[1 TO 1]="]"∨S[1 TO 1]=",")
	   THEN S←S[2 TO ∞]
      ELSE T←T&LOP(S);
      IF S[1 TO 1]=":" THEN
	 BEGIN
	 DV←T;
	 S←S[2 TO ∞];
	 FILSPEC←S;
	 END
      ELSE S←FILSPEC;

      T←""; LCNT←0;
      WHILE LENGTH(S)>0 ∧ (LITR ∨ (S[1 TO 1]≠"." ∧ S[1 TO 1]≠"[")) DO
      IF S[1 TO 1]="↓" THEN
	BEGIN LITR←¬LITR; S←S[2 TO ∞]; LCNT←LCNT+1; END
      ELSE IF (¬LITR)∧(S[1 TO 1]=" "∨S[1 TO 1]="   "∨S[1 TO 1]="]"∨S[1 TO 1]=",")
	   THEN S←S[2 TO ∞]
      ELSE T←T&LOP(S);
      IF LENGTH(T)>0 ∨ LCNT>0 THEN FN1←T;

      IF S[1 TO 1]="." THEN
	 BEGIN
	 S←S[2 TO ∞];
	 T←"";
	 WHILE LENGTH(S)>0 ∧ (LITR ∨ S[1 TO 1]≠"[") DO
	 IF S[1 TO 1]="↓" THEN
	   BEGIN LITR←¬LITR; S←S[2 TO ∞]; END
	 ELSE IF (¬LITR)∧(S[1 TO 1]=" "∨S[1 TO 1]="   "∨S[1 TO 1]="]"∨S[1 TO 1]=",")
	      THEN S←S[2 TO ∞]
	 ELSE T←T&LOP(S);
	 FN2←T;
	 END;

      IF S[1 TO 1]="[" THEN
	 BEGIN
	 S←S[2 TO ∞];
	 FILSPEC←S;
	 T←""; LCNT←0;
	 WHILE LENGTH(S)>0 ∧ (LITR ∨ (S[1 TO 1]≠"," ∧ S[1 TO 1]≠"]")) DO
	 IF S[1 TO 1]="↓" THEN
	   BEGIN LITR←¬LITR; S←S[2 TO ∞]; LCNT←LCNT+1; END
	 ELSE IF (¬LITR)∧(S[1 TO 1]=" "∨S[1 TO 1]="   ") THEN S←S[2 TO ∞]
	 ELSE T←T&LOP(S);
	 IF LENGTH(T)>0 ∨ LCNT>0 THEN PRJ←T;
	 END;

      IF S[1 TO 1]="," THEN
	 BEGIN
	 S←S[2 TO ∞];
	 T←""; LCNT←0;
	 WHILE LENGTH(S)>0 ∧ (LITR ∨ S[1 TO 1]≠"]") DO
	 IF S[1 TO 1]="↓" THEN
	   BEGIN LITR←¬LITR; S←S[2 TO ∞]; LCNT←LCNT+1; END
	 ELSE IF (¬LITR)∧(S[1 TO 1]=" "∨S[1 TO 1]="   ") THEN S←S[2 TO ∞]
	 ELSE T←T&LOP(S);
	 IF LENGTH(T)>0 ∨ LCNT>0 THEN PRG←T;
	 END;
      END;
   IF LENGTH(DV)>6  THEN DV←DV[1 TO 6]   ELSE WHILE LENGTH(DV)<6  DO DV ←DV&" " ;
   IF LENGTH(FN1)>6 THEN FN1←FN1[1 TO 6] ELSE WHILE LENGTH(FN1)<6 DO FN1←FN1&" ";
   IF LENGTH(FN2)>3 THEN FN2←FN2[1 TO 3] ELSE WHILE LENGTH(FN2)<3 DO FN2←FN2&" ";
   IF LENGTH(PRJ)>3 THEN PRJ←PRJ[1 TO 3] ELSE WHILE LENGTH(PRJ)<3 DO PRJ←" "&PRJ;
   IF LENGTH(PRG)>3 THEN PRG←PRG[1 TO 3] ELSE WHILE LENGTH(PRG)<3 DO PRG←" "&PRG;
   END;

   INTERNAL PROCEDURE INSWAP(STRING FILE);
      BEGIN
      INTEGER ARRAY GETADR[0:5];
      PRSFIL(FILE);
      GETADR[0]←CVSIX(DV);
      GETADR[1]←CVSIX(FN1);
      GETADR[2]←CVSIX(FN2&"   ");
      GETADR[3]←0;
      GETADR[4]←CVSIX(PRJ&PRG);
      GETADR[5]←0;
      CALL(LOCATION(GETADR[0]),"SWAP");
      END;

   INTERNAL INTEGER PROCEDURE EXSWAP(STRING FILE);
      BEGIN
      INTEGER ARRAY GETADR[0:5];
      PRSFIL(FILE);
      GETADR[0]←CVSIX(DV);
      GETADR[1]←CVSIX(FN1);
      GETADR[2]←CVSIX(FN2&"   ") LOR '14;
      GETADR[3]←0;
      GETADR[4]←CVSIX(PRJ&PRG);
      GETADR[5]←0;
      RETURN(CALL(LOCATION(GETADR[0]),"SWAP"));
      END;

END;